Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue56/Splat/zwave.pas

Pascal/Delphi Source File | 2000-02-25 | 16.2 KB | 539 lines

unit ZWave;

interface

// Simple routines for working with ZLIB-compressed WAVE files and resources.
// Compress compresses a WAV file or stream.
// PlayCompressedSound plays back a compressed WAV file or resource.
//
// PlayCompressedSound works just like PlaySound. See the Windows API
// documentation for details.
//
// The resource type to use for compresses WAVE files is 'ZWAVE', which is
// the value of the zwaveResourceType constant. The ZWAVE compressed contents
// starts with a 4-byte length of the compressed data, followed by the
// actual compressed data.
//
// ZLIB-compressed WAV files tend to be about 50-60% of the size of the
// original WAV file.
//
// Copyright ⌐ 1999 Tempest Software, Inc.

uses Windows, SysUtils, Classes;

// The arguments are similar to PlaySound.
function PlayCompressedSound(pszSound: PChar; hmod: HINST; fdwSound: Cardinal): LongBool; overload;
// As a convenience for Delphi programs, specify a file name or resource
// name as a Delphi string instead of a PChar.
function PlayCompressedSound(const strSound: string; hmod: HINST; fdwSound: Cardinal): LongBool; overload;

// Compress a WAV file or stream.
// Compress a stream, starting from its current position and extending
// to the end of the stream. Write to the output stream, starting at
// the current position.
procedure Compress(InStream, OutStream: TStream); overload;
// Compress an input stream, overwriting the output file with the compressed
// ZWAV results.
procedure Compress(InStream: TStream; const OutFile: string); overload;
// Open a WAV file and compress its contents, writing to a ZWAV file.
procedure Compress(const InFile, OutFile: string); overload;
// Open a WAV file and compress its contents, overwriting an output file.
// The output file has the same name as the input file, but with the '.zwav'
// extension.
procedure Compress(const InFile: string); overload;

// Compress all .WAV files in a directory.
procedure CompressDirectory(const DirName: string);

// Enumerate all ZWAVE resources. The caller supplies the callback function
// whose signature must match TZWaveEnumFunc. The function returns True
// to continue enumerating resources or False to stop.
type
  TZWaveEnumFunc = function(hmod: HINST; ResName: PChar): Boolean of object;

// Return True after enumerating all resources, or False if EnumFunc
// stopped early by returning False.
function EnumZWaveResources(hmod: HINST; EnumFunc: TZWaveEnumFunc): Boolean;

type
  // A ZWAVE file or resource has the following format: the first four
  // bytes contain the size of the compressed data, which follow immediately
  // after the size. Resource should always contain an explicit size field
  // because Windows pads resource data to fit on longword boundaries.
  PZWaveData = ^TZWaveData;
  TZWaveData = packed record
    Size: 0..MaxInt;
    Data: TByteArray;
  end;

  PZWaveCacheNode = ^TZWaveCacheNode;
  TZWaveCacheNode = record
    // Save the arguments to PlayCompressedSound to look for a match.
    pszSound: Pointer;
    strSound: string;
    hmod: HINST;
    fdwSound: DWORD;
    Data: PZWaveData;
    Next: PZWaveCacheNode;
    Prev: PZWaveCacheNode;
  end;

  // Cache the most recently used ZWAVE data, to avoid repeatedly
  // uncompressing the same ZWAVE file or resource. Zero means no caching
  // (except that Snd_Async requires a cache size of at least 1).
  // The cache is searched linearly, so don't use a large cache size.
  // To avoid problems, the maximum size is set arbitrarily to 100.
  TZWaveCacheSize = 0..100;

  TZWaveCache = class
  private
    fHead, fTail: PZWaveCacheNode;
    fCount: TZWaveCacheSize;
    fCapacity: TZWaveCacheSize;
    procedure SetCapacity(NewCapacity: TZWaveCacheSize);
  protected
    function Invariant: Boolean;
    procedure Add(pszSound: PChar; hmod: HINST; fdwSound: DWORD;
      Buffer: PZWaveData);
    procedure FreeNode(Node: PZWaveCacheNode);
    function Lookup(pszSound: PChar; hmod: HINST;
      fdwSound: DWORD): PZWaveData;

    property Head: PZWaveCacheNode read fHead;
    property Tail: PZWaveCacheNode read fTail;
  public
    constructor Create;
    destructor Destroy; override;

    property Count: TZWaveCacheSize read fCount;
    property Capacity: TZWaveCacheSize read fCapacity write SetCapacity default 1;
  end;

const
  zwaveResourceType = 'ZWAVE';

var
  Cache: TZWaveCache;

implementation

uses MMSystem, ZLib;

{ TZWaveCache }

constructor TZWaveCache.Create;
begin
  inherited;
  // Default capacity is 1 so a sound that is played with the Snd_ASync flag
  // does not get freed prematurely.
  // Set the Capacity to zero only if the Snd_Sync flag is always used.
  fCapacity := 1;
end;

destructor TZWaveCache.Destroy;
begin
  // Set the capacity to zero to free all cached sound buffers.
  Capacity := 0;
  inherited;
end;

// Return True if the sound source is actually a string, that is,
// a file name or resource name (but not an integer resource ID).
function IsString(pszSound: PChar; fdwSound: DWORD): Boolean;
begin
  if (fdwSound and Snd_FileName) = Snd_FileName then
    Result := True
  else if (fdwSound and Snd_Resource) <> Snd_Resource then
    Result := False
  else
    Result := LongRec(pszSound).Hi <> 0;
end;

// Insert an entry at the head of the cache list. If the cache is too big,
// remove an item from the end.
procedure TZWaveCache.Add(pszSound: PChar; hmod: HINST; fdwSound: DWORD; Buffer: PZWaveData);
var
  Node: PZWaveCacheNode;
begin
  Assert(Invariant);
  New(Node);
  if IsString(pszSound, fdwSound) then
  begin
    Node.pszSound := nil;
    Node.strSound := pszSound;
  end
  else
    Node.pszSound := pszSound;
  Node.hmod := hmod;
  Node.fdwSound := fdwSound;
  Node.Data := Buffer;

  Node.Prev := nil;
  Node.Next := Head;
  if Tail = nil then
    fTail := Node;
  if Head <> nil then
    Head.Prev := Node;
  fHead := Node;

  if Count < Capacity then
    Inc(fCount)
  else
  begin
    // Cache capacity has been reached, so drop one item from
    // the end of the cache.
    Node := Tail;
    fTail := Tail.Prev;
    if Tail = nil then
      fHead := nil
    else
      Tail.Next := nil;
    Assert(Invariant);
    FreeNode(Node);
  end;
end;

// Free a cache node. If the data were loaded from a file, free the data, too.
procedure TZWaveCache.FreeNode(Node: PZWaveCacheNode);
begin
  if (Snd_FileName and Node.fdwSound) = Snd_FileName then
    FreeMem(Node.Data);
  Dispose(Node);
end;

// Invariant is an expression that is always true when any method
// starts or returns.
function TZWaveCache.Invariant: Boolean;
begin
  Result := (Count <= Capacity) and
            (((Count = 0) and (Head = nil) and (Tail = nil)) or
             ((Count = 1) and (Head = Tail) and (Head.Next = nil) and (Head.Prev = nil)) or
             ((Count = 2) and (Head <> nil) and (Tail <> nil) and (Head.Next = Tail) and (Head.Prev = nil) and (Tail.Next = nil) and (Tail.Prev = Head)) or
             ((Count > 2) and (Head <> nil) and (Tail <> nil) and (Head.Prev = nil) and (Tail.Next = nil)));
end;

function SameSound(Node: PZWaveCacheNode; pszSound: PChar; hmod: HINST; fdwSound: DWORD): Boolean;
begin
  if Node.fdwSound <> fdwSound then
    // Flags must match exactly.
    Result := False
  else if Node.hmod <> hmod then
    // Module handle must match exactly. If the handle is not used,
    // the caller must use 0.
    Result := False
  else if (Node.pszSound = nil) and (Node.strSound <> '') then
    // If the stored sound has a string name (file or resource name),
    // compare the strings.
    Result := SameText(Node.strSound, pszSound)

  else
    // Otherwise, the sound pointer is a resource ID or memory pointer,
    // both of which can be compared verbatim.
    Result := pszSound = Node.pszSound
end;

// Look up an item in the cache and returns its data. If found,
// move the node to the head of the list--to keep track of
// which item is most-recently used.
function TZWaveCache.Lookup(pszSound: PChar; hmod: HINST; fdwSound: DWORD): PZWaveData;
var
  Node: PZWaveCacheNode;
begin
  Assert(Invariant);
  Node := Head;
  while Node <> nil do
  begin
    if SameSound(Node, pszSound, hmod, fdwSound) then
    begin
      Result := Node.Data;
      // Move this node to the head of the list.
      if Node.Prev <> nil then
      begin
        Assert((Head <> nil) and (Tail <> nil));
        // Node is not already at the head of the list.
        // First remove Node from its position in the list.
        Node.Prev.Next := Node.Next;
        if Node.Next = nil then
          fTail := Node.Prev
        else
          Node.Next.Prev := Node.Prev;
        // Then insert Node at the head of the list.
        Node.Prev := nil;
        Node.Next := Head;
        Head.Prev := Node;
        fHead := Node;
      end;
      Assert(Invariant);
      Exit;
    end;
    Node := Node.Next;
  end;
  Result := nil;
end;

// Alter the cache capacity. If the capacity is smaller than the current
// count, drop excess items from the least-recently used end of the cache.
procedure TZWaveCache.SetCapacity(NewCapacity: TZWaveCacheSize);
var
  Node: PZWaveCacheNode;
begin
  Assert(Invariant);
  // If the new size is smaller than the current size,
  // get rid of the end of the cache.
  while Count > NewCapacity do
  begin
    Node := Tail;
    // Make sure the cache pointers remain correct--just in case
    // FreeNode raises an exception.
    if Tail.Prev = nil then
      fHead := nil
    else
      Tail.Prev.Next := nil;
    fTail := Tail.Prev;
    Dec(fCount);
    FreeNode(Node);
  end;
  fCapacity := NewCapacity;
  Assert(Invariant);
end;


// Get the contents of a ZWAVE file and allocate memory to store the contents,
// setting Buffer to point to the data. The caller must free Buffer.
function GetFileContents(const FileName: string; var Buffer: PZWaveData): Boolean;
var
  FileStream: TFileStream;
begin
  Buffer := nil;
  try
    FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  except
    on EFOpenError do
    begin
      Result := False;
      Exit;
    end;
    else
      raise;
  end;

  try
    GetMem(Buffer, FileStream.Size);
    FileStream.ReadBuffer(Buffer^, FileStream.Size);
  finally
    FileStream.Free;
  end;
  Result := True;
end;

// Get a ZWAVE resource in Buffer. The caller must NOT free Buffer--Windows
// takes care of deallocating resources automatically.
// The resource type is 'ZWAVE'.
function GetResourceContents(hMod: HINST; ResName: PChar; var Buffer: PZWaveData): Boolean;
var
  ResInfo: HRSRC;
  ResData: HGlobal;
begin
  Result := False;
  ResInfo := FindResource(hmod, ResName, zwaveResourceType);
  if ResInfo = 0 then
    Exit;
  ResData := LoadResource(hmod, ResInfo);
  if ResData = 0 then
    Exit;
  Buffer := LockResource(ResData);
  if Buffer = nil then
    Exit;
  Result := True;
end;

// Convenience routine to call FreeMem and set a pointer to nil.
procedure FreeAndNilMem(var P);
var
  Tmp: Pointer;
begin
  Tmp := Pointer(P);
  Pointer(P) := nil;
  FreeMem(Tmp);
end;

// Load the sound data and decompress it into OutBuf.
// Return True for success, False if the sound resource or file
// could not be loaded.
function LoadSound(pszSound: PChar; hmod: HINST; fdwSound: Cardinal; var OutBuf: Pointer): Boolean;
var
  InBuf: PZWaveData;
  FreeInBuf: Boolean;
  OutSize: Integer;
begin
  InBuf := nil;
  OutBuf := nil;
  FreeInBuf := False;
  try
    if (fdwSound and Snd_FileName) = Snd_FileName then
    begin
      // pszSound is a file name. PlayCompressedSound must free InBuf.
      if not GetFileContents(pszSound, InBuf) then
      begin
        Result := False;
        Exit;
      end;
      FreeInBuf := True;
    end
    else if (fdwSound and Snd_Resource) = Snd_Resource then
    begin
      // pszSound is a resource name. Windows takes care of freeing
      // InBuf, so PlayCompressedSound must not free it.
      if not GetResourceContents(hmod, pszSound, InBuf) then
      begin
        Result := False;
        Exit;
      end;
    end
    else if (fdwSound and Snd_Memory) = Snd_Memory then
    begin
      // pszSound points to the sound data in memory. PlayCompressedSound
      // must not free the memory--that is the caller's responsibility.
      InBuf := PZWaveData(pszSound);
    end
    else
    begin
      // Must be a registry alias (Snd_Alias), or something else, such as
      // Snd_Purge. Let PlaySound handle this case. In particular,
      // aliases cannot be compressed because they are used by other programs
      // that don't know about ZWAVEs.
      Result := PlaySound(pszSound, hmod, fdwSound);
      Exit;
    end;

    // Decompress the data. The estimated size is twice the input size.
    // Most ZWAVE files are about 50-60% of the original size.
    DecompressBuf(@InBuf.Data, InBuf.Size, 2*InBuf.Size, OutBuf, OutSize);
    // Remember this sound.
    Cache.Add(pszSound, hmod, fdwSound, OutBuf);
  finally
    if FreeInBuf then
      FreeMem(InBuf);
  end;
  Result := True;
end;

// Look up a compressed sound in the cache. If it isn't present, load
// and decompress the sound data. Then play the decompressed sound.
function PlayCompressedSound(pszSound: PChar; hmod: HINST; fdwSound: Cardinal): LongBool;
var
  Buffer: Pointer;
begin
  Buffer := Cache.Lookup(pszSound, hmod, fdwSound);
  if Buffer = nil then
  begin
    Result := LoadSound(pszSound, hmod, fdwSound, Buffer);
    if Buffer = nil then
      Exit;
  end;

  // Play the sound from memory.
  fdwSound := (fdwSound and not (Snd_Resource or Snd_FileName)) or Snd_Memory;
  Result := PlaySound(Buffer, 0, fdwSound);
end;

function PlayCompressedSound(const strSound: string; hmod: HINST; fdwSound: Cardinal): LongBool;
begin
  Result := PlayCompressedSound(PChar(strSound), hmod, fdwSound);
end;

// Compress the WAVE data from InStream onto OutStream.
procedure Compress(InStream, OutStream: TStream);
var
  InBuffer, OutBuffer: Pointer;
  OutSize: LongInt;
begin
  InBuffer := nil;
  OutBuffer := nil;
  try
    GetMem(InBuffer, InStream.Size);
    InStream.ReadBuffer(InBuffer^, InStream.Size);
    CompressBuf(InBuffer, InStream.Size, OutBuffer, OutSize);
    OutStream.WriteBuffer(OutSize, SizeOf(OutSize));
    OutStream.WriteBuffer(OutBuffer^, OutSize);
  finally
    FreeMem(InBuffer);
    FreeMem(OutBuffer);
  end;
end;

procedure Compress(InStream: TStream; const OutFile: string);
var
  OutStream: TFileStream;
begin
  OutStream := TFileStream.Create(OutFile, fmCreate);
  try
    Compress(InStream, OutStream);
  finally
    OutStream.Free;
  end;
end;

procedure Compress(const InFile, OutFile: string);
var
  InStream, OutStream: TFileStream;
begin
  InStream := nil;
  OutStream := nil;
  try
    InStream := TFileStream.Create(InFile, fmOpenRead or fmShareDenyWrite);
    OutStream := TFileStream.Create(OutFile, fmCreate);
    Compress(InStream, OutStream);
  finally
    InStream.Free;
    OutStream.Free;
  end;
end;

procedure Compress(const InFile: string);
begin
  Compress(InFile, ChangeFileExt(InFile, '.zwav'));
end;

// Compress all .WAV files in a directory.
procedure CompressDirectory(const DirName: string);
var
  Search: TSearchRec;
  Path: string;
begin
  Path := IncludeTrailingBackslash(DirName);
  if FindFirst(Path + '*.wav', faAnyFile, Search) = 0 then
    try
      repeat
        Compress(Path + Search.Name);
      until FindNext(Search) <> 0;
    finally
      FindClose(Search);
    end;
end;


// TZWaveEnumFunc is a TMethod, which doesn't fit into an LParam, so pass
// the address of the method record, that is, PZWaveEnumFunc.
type
  PZWaveEnumFunc = ^TZWaveEnumFunc;

function EnumZWave(hmod: HINST; ResType, ResName: PChar;
    EnumFunc: PZWaveEnumFunc): LongBool; stdcall;
begin
  Result := EnumFunc^(hmod, ResName);
end;

// Enumerate all the ZWAVE resources.
function EnumZWaveResources(hmod: HINST; EnumFunc: TZWaveEnumFunc): Boolean;
begin
  Result := EnumResourceNames(hmod, zwaveResourceType, @EnumZWave, LParam(@@EnumFunc));
end;

initialization
  Cache := TZWaveCache.Create;
finalization
  Cache.Free;
end.